home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / SMALLTAL / SMALLT < prev    next >
Text File  |  1989-02-09  |  11KB  |  381 lines
  1. " 
  2. This file contains fixes to the following Smalltalk/V Mac bugs:
  3.         
  4. PRINTING
  5.  
  6. - ImageWriter printers don't print.
  7. - lines containing only a single CR don't print (this bug also causes
  8.   early termination of printing when the last line on a page is blank).
  9. - on a standard size page, the last line of output is clipped at
  10.   the bottom of the page.
  11. - when a line must be wrapped to fit the width of a page, the
  12.   last character of the line is lost.
  13. - the contents of a TextPane is always printed with the default font
  14.   rather than the font actually in the TextPane.
  15.  
  16. SCREEN
  17.  
  18. - with multiple monitors, Smalltalk/V Mac opens very large window
  19.   across all available screens;  grey area not restored on leaving
  20.   application.
  21.  
  22. ****** Note:  this file will file in OK on either Smalltalk/V Mac
  23.               or Smalltalk/V Mac 68000.
  24. "!
  25.  
  26. !MTrap class methods !
  27. PrPicFile: hPrint pPrPort: pPrPort pIOBuf: pIOBuf pDevBuf: pDevBuf prStatus: prStatus
  28.     "Printing Manager.
  29.         Print the spooled copy of the document.
  30.         WARNING: prStatus passed in as pointer but defined
  31.                  as record*.  Look at the sender of this method
  32.                  to see how this was done.
  33.         (Inside Macintosh II-160)"
  34.     <trap: stack long 16rA8FD handle pointer pointer pointer pointer 16r1480 16r6005>
  35.  
  36.     ^ self trapFailed! !
  37.  
  38. MType subclass: #TPrint
  39.   instanceVariableNames: ''
  40.   classVariableNames:
  41.     'THPrint PrintStatus'
  42.   poolDictionaries: ''!
  43.  
  44. !TPrint class methods !
  45. statusBuffer                               
  46.     "Answer a buffer to use for holding the printer status
  47.      information."    
  48.  
  49.     PrintStatus isNil ifTrue: [
  50.         PrintStatus := MPointer new: 26.
  51.     ].
  52.     ^ PrintStatus
  53. ! !
  54.  
  55. !TPrint class methods !
  56. invalidate
  57.     "Close and Nil out the THPrint."
  58.  
  59.     THPrint isNil ifFalse: [
  60.         MTrap PrClose.
  61.         THPrint := nil
  62.     ].
  63.     PrintStatus isNil ifFalse: [
  64.         PrintStatus dispose.
  65.         PrintStatus := nil.
  66.     ].
  67. ! !
  68.  
  69. !TPrint class methods !
  70. printSpooledDocument
  71.     "Cause the spooled document to be printed."
  72.  
  73.     self validate.
  74.     THPrint spooling ifTrue: [
  75.         MTrap PrPicFile: THPrint asParameter
  76.                 pPrPort: nil asParameter
  77.                  pIOBuf: nil asParameter
  78.                 pDevBuf: nil asParameter
  79.                prStatus: self statusBuffer asParameter
  80.     ]
  81. ! !
  82.  
  83. !MTrap class methods !
  84.  
  85. TextSize: n
  86.     "QuickDraw.
  87.         Set the text point size.
  88.         (Inside Macintosh I-171)"
  89.     <trap: stack procedure 16rA88A integer>
  90.  
  91.     ^ self trapFailed! !
  92.  
  93. !PrintStream methods !
  94. close
  95.     "Close the current page and the document."
  96.  
  97.     port closePage ifFalse: [
  98.         self error: 'error in printing'.
  99.     ].
  100.     port closeDocument ifFalse: [
  101.         self error: 'error in printing'.
  102.     ].
  103.     TPrint printSpooledDocument
  104. ! !
  105.  
  106. !PrintStream methods !
  107. printCurrentLine
  108.     "Print the current line on the printer."
  109.  
  110.     column ~= 1 ifTrue: [
  111.         line byteAtOffset: 0 put: column - 1.
  112.         Process enableInterrupts: false.
  113.         GrafPort pushTo: port.
  114.         self position: 1 @ row.
  115.         MTrap DrawString: line asParameter.
  116.         GrafPort pop.
  117.         Process enableInterrupts: true.
  118.     ].
  119.     row = pageHeight ifTrue: [ ^ self newPage ].
  120.     column := 1.
  121.     row := row + 1.
  122. ! !
  123.  
  124. !PrintStream methods !
  125. nextPut: aCharacter
  126.     "Write anObject to the receiver stream. Answer anObject."
  127.  
  128.     aCharacter = Cr
  129.         ifTrue: [ ^ self printCurrentLine ].
  130.     aCharacter = Ff
  131.         ifTrue: [ ^ self newPage ].
  132.     line byteAtOffset: column put: aCharacter asciiValue.
  133.     column := column + 1.
  134.     column = pageWidth
  135.         ifTrue: [ ^ self printCurrentLine ].
  136.     ^ aCharacter
  137. ! !
  138.  
  139. !PrintStream methods !
  140. initialize: aTPrPort
  141.     "Initialize the instance variables of the receiver
  142.      using the aTPrPort and the current TPrint record."
  143.     | size |
  144.  
  145.     port := aTPrPort.
  146.     port penNormal.
  147.     pageNumber := 1.
  148.     self font: (MacFont fontName: 'Monaco' pointSize: 12).
  149.     size := TPrint current pageSize.
  150.     pageWidth := (size x // (font width / 72) min: 255) - 1.
  151.     pageHeight := size y // (font height / 72) - 1.
  152.     row := 1.
  153.     column := 1.
  154.     line := Str255 newRecord.
  155.     port openPage.
  156. ! !
  157. !PrintStream class methods !
  158.  
  159. on: aTPrPort using: aFont
  160.     "Answer a new instance of the receiver which
  161.      which will print on aTPrPort."
  162.  
  163.     ^ self new initialize: aTPrPort using: aFont! !
  164.  
  165. !PrintStream methods !
  166.  
  167. initialize: aTPrPort using: aFont
  168.     "Initialize the instance variables of the receiver
  169.      using the aTPrPort and the current TPrint record."
  170.     | size |
  171.  
  172.     port := aTPrPort.
  173.     port penNormal.
  174.     pageNumber := 1.
  175.     self font: aFont.
  176.     size := TPrint current pageSize.
  177.     pageWidth := 255.
  178.     pageHeight := size y // (font height / 72).
  179.     row := 1.
  180.     column := 1.
  181.     line := Str255 newRecord.
  182.     port openPage.!
  183.  
  184. font: aFont
  185.     "Set the font to use for printing to aFont."
  186.  
  187.     aFont isMacFont ifFalse: [
  188.         self error: 'Font must be a MacFont'].
  189.  
  190.     font := aFont.
  191.     Process enableInterrupts: false.
  192.     GrafPort pushTo: port.
  193.     MTrap
  194.         TextFont: font glyphs;
  195.         TextSize: font pointSize.
  196.     GrafPort pop.
  197.     Process enableInterrupts: true.! !
  198.  
  199.  
  200. !TextPane methods !
  201.  
  202. print
  203.     "Print the contents of the receiver."
  204.     | port printStream |
  205.  
  206.     (port := TPrint print) isNil ifTrue: [ ^ self ].
  207.     printStream := PrintStream on: port using: curFont.
  208.     CursorManager execute change.
  209.     textHolder lines do: [ :line |
  210.         printStream nextPutAll: line; cr.
  211.     ].
  212.     printStream close.
  213.     CursorManager normal change! !
  214.  
  215.  
  216. "   *** This fix for multiple monitors works ONLY for Finder.  It's 
  217.     OK to file in even if you use MultiFinder, but doesn't fix the
  218.     problem."!
  219.  
  220. !MTrap class methods !
  221. InitWindows
  222.     "Window Manager.
  223.         Initialize the window system.
  224.         (Inside Macintosh I-281)"
  225.     <trap: stack procedure 16rA912>
  226.  
  227.     ^ self trapFailed! !
  228.  
  229. !SystemDictionary methods !
  230. startUp
  231.     "Initiate a Smalltalk/ V session by filing in the' go'
  232.      file. This message is sent by the virtual machine."
  233.      | sourceDirectory |
  234.  
  235.     "Set up the display screen."
  236.     MTrap InitWindows.
  237.     ScreenPort := Window windowManagerPort.
  238.     DisplayScreen Mac.
  239.  
  240.     "Force any menus in the image which may be added
  241.      to the menu bar to be properly initialized."
  242.     MenuBar message: 'Initializing╔'.
  243.     Menu startUp: false.
  244.  
  245.     "If go file specified, then file it in. If the
  246.      sources or changes files are unspecified afterwards,
  247.      file them in with the defaults."
  248.     Sources := Array new: 2.
  249.     sourceDirectory := Directory current.
  250.     Smalltalk openChangeLog: sourceDirectory.
  251.     Disk := (Sources at: 2) file directory.
  252.     (Disk hasFileNamed: 'go')
  253.         ifTrue: [ (Disk file: 'go') fileIn; close ].
  254.     (Sources at: 1) isNil
  255.         ifTrue: [ Sources at: 1 put: (sourceDirectory file: 'V.source') ].
  256.  
  257.     "Do any other required system initialization."
  258.     Time initialize.
  259.     CompiledMethod initializeUserPrimitives.
  260.     Smalltalk openFilesFromDeskTop.
  261.     MenuBar clear.
  262.     Process enableInterrupts: true.
  263.     Scheduler resume
  264. ! !
  265.  
  266. "   The following method causes windows to be opened on the main screen."!
  267.  
  268. !TopDispatcher class methods !
  269. nextFrame
  270.     "Answer a screen rectangle (global coordinates) in
  271.      which to stack the next window."
  272.     | aPoint mainWindowFrame |
  273.  
  274.     OpenPoint := OpenPoint isNil ifTrue:  [ 0 ]
  275.                                  ifFalse: [ OpenPoint + 1 ].
  276.     OpenPoint > 20
  277.         ifTrue: [ OpenPoint := 0 ].
  278.     aPoint :=
  279.         ((5 @ 18) * (OpenPoint \\ 5)) +
  280.             ((27 @ -2) * (OpenPoint // 5)) +
  281.                 (35 @ 50).
  282.  
  283.     mainWindowFrame := ScreenPort screenRect.
  284.     ^ aPoint + mainWindowFrame origin
  285.         corner:
  286.             aPoint + (mainWindowFrame corner * 3 // 4)
  287. ! !
  288.  
  289. "    The following method assures that menu bar messages
  290.      are displayed on the screen that has the menu bar."!
  291.  
  292. !MenuBar class methods !
  293. message: aString
  294.     "Display a message in the menu bar."
  295.     | rect |
  296.  
  297.     MTrap ClearMenuBar; DrawMenuBar.
  298.     aString displayAt: 10 @ 2 + Screen boundingBox origin negated
  299.                  font: Font menuFont
  300.                  dest: Screen
  301. ! !
  302.  
  303.  
  304. !GlobalDisplayScreen methods !
  305. boundingBox
  306.     "Answer a Rectangle which bounds the receiver."
  307.     | answer |
  308.  
  309.     answer := Region GrayRgn boundingBox.
  310.     answer origin y: (answer origin y min: 0). 
  311.     ^ answer
  312. ! !
  313.  
  314. "The following code causes error notifiers to pop up centered 
  315. on your main screen."!
  316.  
  317. !Debugger methods !
  318. walkbackFor: aProcess label: aString
  319.     "Pop-up a walkback window with label equal to aString).
  320.      Display the stacked message sends for the receiver in
  321.      the window."
  322.     | recursing extent logger listLineHeight aTopPane |
  323.  
  324.     process := aProcess.
  325.     recursing := RecursionInError.
  326.     maxLevel := 10.
  327.     RecursionInError
  328.         ifTrue: [
  329.             logger := Terminal.
  330.             logger cr; nextPutAll: 'error: ',aString; cr]
  331.         ifFalse: [
  332.             RecursionInError := true.
  333.             logger := WriteStream on: (String new: 40).
  334.         ].
  335.     aProcess walkbackOn: logger maxLevels: maxLevel.
  336.     RecursionInError := false.
  337.     Process enableInterrupts: true.
  338.     recursing ifTrue: [
  339.         ^ Smalltalk exit: false
  340.     ] ifFalse: [
  341.         extent := ((350 max:
  342.                     (LabelFont stringWidth: aString) + 40) min:
  343.                         ScreenPort screenRect width - 20)
  344.                     @ 250.
  345.         label := aString.
  346.         listLineHeight := Font menuFont height + 8.
  347.         aTopPane := TopPane new.
  348.         aTopPane
  349.             label: label;
  350.             model: self;
  351.             menu: #walkbackMenu;
  352.             minimumSize: 200@100;
  353.             addSubpane:
  354.                 (TextPane new
  355.                     model: logger contents;
  356.                     framingBlock: [ :box |
  357.                         box origin + (0 @ listLineHeight)
  358.                             corner: box corner
  359.                     ]).
  360.         aTopPane addSubpane:
  361.             (ButtonPane new
  362.                 model: self;
  363.                 buttons: #(Resume Debug);
  364.                 framingBlock: [ :box |
  365.                     box origin corner: box width @ listLineHeight
  366.                 ];
  367.                 pulse: true).
  368.         aTopPane dispatcher
  369.             openIn: (ScreenPort screenRect extent // 2
  370.                         - (extent // 2)
  371.                             extent: extent);
  372.             scheduleWindow.
  373.         Scheduler run
  374.     ]
  375. ! !
  376.  
  377.  
  378.  
  379.  
  380.